home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / STYLES.FRM < prev    next >
Text File  |  1996-01-23  |  3KB  |  102 lines
  1. VERSION 4.00
  2. Begin VB.Form StylesForm 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Styles"
  6.    ClientHeight    =   4140
  7.    ClientLeft      =   1200
  8.    ClientTop       =   1725
  9.    ClientWidth     =   6690
  10.    Height          =   4830
  11.    Left            =   1140
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   207
  14.    ScaleMode       =   2  'Point
  15.    ScaleWidth      =   334.5
  16.    Top             =   1095
  17.    Width           =   6810
  18.    Begin VB.Menu mnuFile 
  19.       Caption         =   "&File"
  20.       Begin VB.Menu mnuFileExit 
  21.          Caption         =   "E&xit"
  22.       End
  23.    End
  24. End
  25. Attribute VB_Name = "StylesForm"
  26. Attribute VB_Creatable = False
  27. Attribute VB_Exposed = False
  28. Option Explicit
  29.  
  30. ' ***********************************************
  31. ' Draw a string on the form using randomly chosen
  32. ' ForeColor, size, bold, and italic values. Start
  33. ' the text at Y position min_y and keep it
  34. ' between the margins min_x and max_x.
  35. ' ***********************************************
  36. Sub RandomStyles(txt As String, min_size As Integer, max_size As Integer, min_x As Single, max_x As Single, min_y As Single)
  37. Dim length As Integer
  38. Dim pos1 As Integer
  39. Dim pos2 As Integer
  40. Dim new_word As String
  41. Dim clr As Long
  42. Dim y As Integer
  43.         
  44.     ' Start with a clean slate.
  45.     Cls
  46.     
  47.     CurrentX = min_x
  48.     y = 0
  49.  
  50.     ' Break the string into words.
  51.     length = Len(txt)
  52.     pos1 = 1
  53.     Do
  54.         ' Get the next word.
  55.         pos2 = InStr(pos1, txt, " ")
  56.         If pos2 = 0 Then
  57.             new_word = Mid$(txt, pos1)
  58.         Else
  59.             new_word = Mid$(txt, pos1, pos2 - pos1)
  60.         End If
  61.         pos1 = pos2 + 1
  62.         
  63.         ' Randomly select a ForeColor.
  64.         clr = QBColor(Int(16 * Rnd))
  65.         If clr = BackColor Then clr = vbBlack
  66.         ForeColor = clr
  67.         
  68.         ' Randomly pick Font properties.
  69.         ' (The Underline and Strikethrough
  70.         ' properties make things too cluttered.)
  71.         Font.Size = Int((max_size - min_size + 1) * Rnd + min_size)
  72.         Font.Bold = (Int(2 * Rnd) = 1)
  73.         Font.Italic = (Int(2 * Rnd) = 1)
  74.         
  75.         ' If the word won't fit, start a new line.
  76.         If CurrentX + TextWidth(new_word) > max_x Then
  77.             CurrentX = min_x
  78.             y = y + 1.25 * max_size
  79.         End If
  80.     
  81.         ' Display the text.
  82.         CurrentY = y + max_size - Font.Size
  83.         Print new_word; " ";
  84.     Loop While pos2 > 0
  85. End Sub
  86.  
  87. ' ***********************************************
  88. ' Call RandomStyles to redraw the text string.
  89. ' ***********************************************
  90. Private Sub Form_Resize()
  91. Const txt = "If you draw some text, modify the Font object, and then draw more text, the two pieces of text will be displayed in different styles. Similarly you can change a form or picture box's ForeColor property to produce text of different colors."
  92.  
  93.     RandomStyles txt, 10, 20, 0, ScaleWidth, 0
  94. End Sub
  95.  
  96.  
  97. Private Sub mnuFileExit_Click()
  98.     Unload Me
  99. End Sub
  100.  
  101.  
  102.